home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / ncurses2-demo_panels.adb < prev    next >
Text File  |  2002-10-24  |  13KB  |  380 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. with ncurses2.util; use ncurses2.util;
  42. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  43. with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  44. with Terminal_Interface.Curses.Panels.User_Data;
  45.  
  46. with ncurses2.genericPuts;
  47.  
  48. procedure ncurses2.demo_panels (nap_mseci : Integer) is
  49.    use Int_IO;
  50.  
  51.    function  mkpanel (color : Color_Number;
  52.                       rows  : Line_Count;
  53.                       cols  : Column_Count;
  54.                       tly   : Line_Position;
  55.                       tlx   : Column_Position) return Panel;
  56.    procedure rmpanel (pan : in out Panel);
  57.    procedure pflush;
  58.    procedure wait_a_while (msec : Integer);
  59.    procedure saywhat (text : String);
  60.    procedure fill_panel (pan : Panel);
  61.  
  62.    nap_msec : Integer := nap_mseci;
  63.  
  64.    function mkpanel (color : Color_Number;
  65.                      rows  : Line_Count;
  66.                      cols  : Column_Count;
  67.                      tly   : Line_Position;
  68.                      tlx   : Column_Position) return Panel is
  69.       win : Window;
  70.       pan : Panel := Null_Panel;
  71.    begin
  72.       win := New_Window (rows, cols, tly, tlx);
  73.       if Null_Window /= win then
  74.          pan := New_Panel (win);
  75.          if pan = Null_Panel then
  76.             Delete (win);
  77.          elsif Has_Colors then
  78.             declare
  79.                fg, bg : Color_Number;
  80.             begin
  81.                if color = Blue then
  82.                   fg := White;
  83.                else
  84.                   fg := Black;
  85.                end if;
  86.                bg := color;
  87.                Init_Pair (Color_Pair (color), fg, bg);
  88.                Set_Background (win, (Ch => ' ',
  89.                                      Attr => Normal_Video,
  90.                                      Color => Color_Pair (color)));
  91.             end;
  92.          else
  93.             Set_Background (win, (Ch => ' ',
  94.                                   Attr => (Bold_Character => True,
  95.                                            others => False),
  96.                                   Color => Color_Pair (color)));
  97.          end if;
  98.       end if;
  99.       return pan;
  100.    end mkpanel;
  101.  
  102.    procedure rmpanel (pan : in out Panel) is
  103.       win : Window := Panel_Window (pan);
  104.    begin
  105.       Delete (pan);
  106.       Delete (win);
  107.    end rmpanel;
  108.  
  109.    procedure pflush is
  110.    begin
  111.       Update_Panels;
  112.       Update_Screen;
  113.    end pflush;
  114.  
  115.    procedure wait_a_while (msec : Integer) is
  116.    begin
  117.       --  The C version had some #ifdef blocks here
  118.       if nap_msec = 1 then
  119.          Getchar;
  120.       else
  121.          Nap_Milli_Seconds (nap_msec);
  122.       end if;
  123.    end wait_a_while;
  124.  
  125.    procedure saywhat (text : String) is
  126.    begin
  127.       Move_Cursor (Line => Lines - 1, Column => 0);
  128.       Clear_To_End_Of_Line;
  129.       Add (Str => text);
  130.    end saywhat;
  131.  
  132.    --  from sample-curses_demo.adb
  133.    type User_Data is new String (1 .. 2);
  134.    type User_Data_Access is access all User_Data;
  135.    package PUD is new Panels.User_Data (User_Data, User_Data_Access);
  136.  
  137.    use PUD;
  138.  
  139.    procedure fill_panel (pan : Panel) is
  140.       win : Window := Panel_Window (pan);
  141.       num : Character := Get_User_Data (pan) (2);
  142.       tmp6 : String (1 .. 6) := "-panx-";
  143.       maxy : Line_Count;
  144.       maxx : Column_Count;
  145.  
  146.    begin
  147.       Move_Cursor (win, 1, 1);
  148.       tmp6 (5) := num;
  149.       Add (win, Str => tmp6);
  150.       Clear_To_End_Of_Line (win);
  151.       Box (win);
  152.       Get_Size (win, maxy, maxx);
  153.       for y in 2 .. maxy - 2 loop
  154.          for x in 1 .. maxx - 2 loop
  155.             Move_Cursor (win, y, x);
  156.             Add (win, num);
  157.          end loop;
  158.       end loop;
  159.    end fill_panel;
  160.  
  161.    modstr : array (0 .. 5) of String (1 .. 5) :=
  162.      ("test ",
  163.       "TEST ",
  164.       "(**) ",
  165.       "*()* ",
  166.       "<--> ",
  167.       "LAST "
  168.       );
  169.  
  170.    package p is new ncurses2.genericPuts (1024);
  171.    use p;
  172.    use p.BS;
  173.    --  the C version said register int y, x;
  174.    tmpb : BS.Bounded_String;
  175.  
  176. begin
  177.    Refresh;
  178.  
  179.    for y in 0 .. Integer (Lines - 2) loop
  180.       for x in 0 .. Integer (Columns - 1) loop
  181.          myPut (tmpb, (y + x) mod 10);
  182.          myAdd (Str => tmpb);
  183.       end loop;
  184.    end loop;
  185.    for y in 0 .. 4 loop
  186.       declare
  187.          p1, p2, p3, p4, p5 : Panel;
  188.          U1 : User_Data_Access := new User_Data'("p1");
  189.          U2 : User_Data_Access := new User_Data'("p2");
  190.          U3 : User_Data_Access := new User_Data'("p3");
  191.          U4 : User_Data_Access := new User_Data'("p4");
  192.          U5 : User_Data_Access := new User_Data'("p5");
  193.  
  194.       begin
  195.          p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
  196.          Set_User_Data (p1, U1);
  197.          p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
  198.                         Columns / 10);
  199.          Set_User_Data (p2, U2);
  200.          p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
  201.                         Columns / 9);
  202.          Set_User_Data (p3, U3);
  203.          p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8,  Lines / 2 - 2,
  204.                         Columns / 3);
  205.          Set_User_Data (p4, U4);
  206.          p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8,  Lines / 2,
  207.                         Columns / 2 - 2);
  208.          Set_User_Data (p5, U5);
  209.  
  210.          fill_panel (p1);
  211.          fill_panel (p2);
  212.          fill_panel (p3);
  213.          fill_panel (p4);
  214.          fill_panel (p5);
  215.          Hide (p4);
  216.          Hide (p5);
  217.          pflush;
  218.          saywhat ("press any key to continue");
  219.          wait_a_while (nap_msec);
  220.  
  221.          saywhat ("h3 s1 s2 s4 s5; press any key to continue");
  222.          Move (p1, 0, 0);
  223.          Hide (p3);
  224.          Show (p1);
  225.          Show (p2);
  226.          Show (p4);
  227.          Show (p5);
  228.          pflush;
  229.          wait_a_while (nap_msec);
  230.  
  231.          saywhat ("s1; press any key to continue");
  232.          Show (p1);
  233.          pflush;
  234.          wait_a_while (nap_msec);
  235.  
  236.          saywhat ("s2; press any key to continue");
  237.          Show (p2);
  238.          pflush;
  239.          wait_a_while (nap_msec);
  240.  
  241.          saywhat ("m2; press any key to continue");
  242.          Move (p2, Lines / 3 + 1, Columns / 8);
  243.          pflush;
  244.          wait_a_while (nap_msec);
  245.  
  246.          saywhat ("s3;");
  247.          Show (p3);
  248.          pflush;
  249.          wait_a_while (nap_msec);
  250.  
  251.          saywhat ("m3; press any key to continue");
  252.          Move (p3, Lines / 4 + 1, Columns / 15);
  253.          pflush;
  254.          wait_a_while (nap_msec);
  255.  
  256.          saywhat ("b3; press any key to continue");
  257.          Bottom (p3);
  258.          pflush;
  259.          wait_a_while (nap_msec);
  260.  
  261.          saywhat ("s4; press any key to continue");
  262.          Show (p4);
  263.          pflush;
  264.          wait_a_while (nap_msec);
  265.  
  266.          saywhat ("s5; press any key to continue");
  267.          Show (p5);
  268.          pflush;
  269.          wait_a_while (nap_msec);
  270.  
  271.          saywhat ("t3; press any key to continue");
  272.          Top (p3);
  273.          pflush;
  274.          wait_a_while (nap_msec);
  275.  
  276.          saywhat ("t1; press any key to continue");
  277.          Top (p1);
  278.          pflush;
  279.          wait_a_while (nap_msec);
  280.  
  281.          saywhat ("t2; press any key to continue");
  282.          Top (p2);
  283.          pflush;
  284.          wait_a_while (nap_msec);
  285.  
  286.          saywhat ("t3; press any key to continue");
  287.          Top (p3);
  288.          pflush;
  289.          wait_a_while (nap_msec);
  290.  
  291.          saywhat ("t4; press any key to continue");
  292.          Top (p4);
  293.          pflush;
  294.          wait_a_while (nap_msec);
  295.  
  296.          for itmp in  0 ..  5 loop
  297.             declare
  298.                w4 : Window := Panel_Window (p4);
  299.                w5 : Window := Panel_Window (p5);
  300.             begin
  301.  
  302.                saywhat ("m4; press any key to continue");
  303.                Move_Cursor (w4, Lines / 8, 1);
  304.                Add (w4, modstr (itmp));
  305.                Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
  306.                Move_Cursor (w5, Lines / 6, 1);
  307.                Add (w5, modstr (itmp));
  308.                pflush;
  309.                wait_a_while (nap_msec);
  310.  
  311.                saywhat ("m5; press any key to continue");
  312.                Move_Cursor (w4, Lines / 6, 1);
  313.                Add (w4, modstr (itmp));
  314.                Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
  315.                Move_Cursor (w5, Lines / 8, 1);
  316.                Add (w5, modstr (itmp));
  317.                pflush;
  318.                wait_a_while (nap_msec);
  319.             end;
  320.          end loop;
  321.  
  322.          saywhat ("m4; press any key to continue");
  323.          Move (p4, Lines / 6, 6 * (Columns / 8));
  324.          --  Move(p4, Lines / 6, itmp * (Columns / 8));
  325.          pflush;
  326.          wait_a_while (nap_msec);
  327.  
  328.          saywhat ("t5; press any key to continue");
  329.          Top (p5);
  330.          pflush;
  331.          wait_a_while (nap_msec);
  332.  
  333.          saywhat ("t2; press any key to continue");
  334.          Top (p2);
  335.          pflush;
  336.          wait_a_while (nap_msec);
  337.  
  338.          saywhat ("t1; press any key to continue");
  339.          Top (p1);
  340.          pflush;
  341.          wait_a_while (nap_msec);
  342.  
  343.          saywhat ("d2; press any key to continue");
  344.          rmpanel (p2);
  345.          pflush;
  346.          wait_a_while (nap_msec);
  347.  
  348.          saywhat ("h3; press any key to continue");
  349.          Hide (p3);
  350.          pflush;
  351.          wait_a_while (nap_msec);
  352.  
  353.          saywhat ("d1; press any key to continue");
  354.          rmpanel (p1);
  355.          pflush;
  356.          wait_a_while (nap_msec);
  357.  
  358.          saywhat ("d4; press any key to continue");
  359.          rmpanel (p4);
  360.          pflush;
  361.          wait_a_while (nap_msec);
  362.  
  363.          saywhat ("d5; press any key to continue");
  364.          rmpanel (p5);
  365.          pflush;
  366.          wait_a_while (nap_msec);
  367.          if (nap_msec = 1) then
  368.             exit;
  369.          else
  370.             nap_msec := 100;
  371.          end if;
  372.  
  373.       end;
  374.    end loop;
  375.  
  376.    Erase;
  377.    End_Windows;
  378.  
  379. end ncurses2.demo_panels;
  380.